Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE02/TPACK/TPACK.ZIP/PASUTILS.PAS

Pascal/Delphi Source File | 1995-06-01 | 9.7 KB | 302 lines

{------------------------------------------------------------------------------}
{UNREGISTERED VERSION (6/1/95) PLEASE REDISTRIBUTE IN tPACK.ZIP!
 This revision does not contain everything, nor are the exciting
 DataSetReporter and ExtendedMenu[Item] components included.
 Use SWREG#5906 to receive these, icons and a help file for $130.
 You must register when using this code in a business application!
 You'll receive a license to use this code in up to 50 copies of
 any app you write. In turn you will get responsive e-mail
 tech support and enhancements till I run out of registrations
 or suggestions. Meanwhile.. enjoy the code. Bye! I'll make more.
 {(C)'1995 Michael/Ax-Systems, 71560,[e-mail]}
{------------------------------------------------------------------------------}

unit PasUtils;
{------------------------------------------------------------------------------}
{ UTILITY LIBRARY                                                   }
{------------------------------------------------------------------------------}


interface

uses
  Classes, ExtCtrls, Forms, TypInfo;

type

  TExceptionReAction = (reAsk, reRetry, reIgnore, reRaise);
    {defines what Retry/ErrorMsg can do in response to an exception}

  TRealRecord = record
    {utility type used to set reals to 0 or to check if they are.}
    {this way from pascal mag, uses 5 instead of 18 bytes and fewer cycles.}
    {set a real to zero:     TRealRecord(RealVar).Exponent:=0; }
    {does a real equal zero: TRealRecord(RealVar).Exponent=0; }
    Exponent: Byte;
    Mantissa: Array[1..5] of Byte;
    end;

{------------------------------------------------------------------------------}
{ UTILITY PROCEDURE DECLARATIONS                                               }
{------------------------------------------------------------------------------}

Procedure CursorOff;                                     { Turn the cursor Off }
Procedure CursorOn;                                      { Turn the Cursor On }

function TrailingChar(const Value:String;Trailer:Char):String; {insures a trailing character}
function TrailingBackSlash(const Value:String):String;         {insures a trailing '\'}

procedure SplitString(const Input:String;SplitAt:Char; var Left,Right:String); {splits at char}

procedure LongintsLowHigh(var Low,High:LongInt);

function Max(i,j:longint):longint;
function Min(i,j:longint):longint;

function ExpXY(x,y:extended):extended;

function FormatNumber(l:LongInt): String;


function FormatCurrency(value:real):string;

function StripString(Input:String;StripChar:Char):String;

function Spaces(n:byte):string;

function GetEnumString(TypeInfo:PTypeInfo;Ordinal:longint):String;

function MakePChar(const Value:String):PChar;
procedure MovePChar2PString(Dest:PString;Source:PChar;aFree:Boolean);
procedure FreePChar(Value:PChar);
function ReceivePChar(Value:PChar):String;

function LeftPadZero(const Value:String; Length:byte):string;


const
  BoolString:array[false..true] of string[5]=('FALSE','TRUE');


{------------------------------------------------------------------------------}
{ PASCAL UTILITY IMPLEMENTATION                                                }
{------------------------------------------------------------------------------}
implementation

uses
  WinProcs
  ,SysUtils;

{------------------------------------------------------------------------------}
{ CURSOR ON/OFF                                                                }
{------------------------------------------------------------------------------}

Procedure CursorOff;                                       { Turn the Cursor Off }
Var
  Cstate : Integer;                                        { Current cursor State }
Begin
  Cstate := ShowCursor(True);                              { Get State }
  While Cstate >= 0 do Cstate := ShowCursor(False);        { While ON turn Off }
End;

Procedure CursorOn;                                        { Turn Cursor On }
Var
  Cstate : Integer;                                        { Current cursor State }
Begin
  Cstate := ShowCursor(True);                              { Get current State }
  While Cstate < 0 do Cstate := ShowCursor(True);          { While off turn on }
End;

{------------------------------------------------------------------------------}
{ TRAILING CHARACTER, TRAILING BACKSLASH                                       }
{------------------------------------------------------------------------------}

function TrailingChar(const Value:String;Trailer:Char):String; {insures a trailing character}
begin
  Result:=Value;
  if copy(Value,length(Value),1)<>Trailer then
    Result:=Result+Trailer;
end;

function TrailingBackSlash(const Value:String):String; {insures a trailing '\'}
begin
  Result:=TrailingChar(Value,'\');
end;

{------------------------------------------------------------------------------}
{ SPLIT STRING AT CHARACTER                                                    }
{------------------------------------------------------------------------------}

procedure SplitString(const Input:String;SplitAt:Char; var Left,Right:String);
{splits 'input' at 'splitchar' into 'left' and 'right' parts}
var n:integer;
begin
n:=pos(SplitAt,Input);
if n=0 then begin
  left:=Input;
  Right:='';
  end
else begin
  Left:=Copy(Input,1,n-1);
  Right:=Copy(Input,n+1,length(Input)-n);
  end;
end;

{---------------------------------------------------------------------------}

function StripString(Input:String;StripChar:Char):String;
{removes 'StripChar' from 'Input'}
var n:integer;
begin
  n:=pos(StripChar,Input);
  while n>0 do begin
    Input:=Copy(Input,1,n-1)+Copy(Input,n+1,length(Input)-n);
    n:=pos(StripChar,Input);
  end;
  Result:=Input;
end;

{------------------------------------------------------------------------------}
{ SWAP LONGINTS FOR PROPER HIGH/LOW                                            }
{------------------------------------------------------------------------------}

procedure LongintsLowHigh(var Low,High:LongInt);
var
  i:longint;
begin
  if Low>High then begin
    i:=low;
    Low:=High;
    High:=i;
    end;
end;

{------------------------------------------------------------------------------}
{ GET HIGH/LOW                                                                 }
{------------------------------------------------------------------------------}

function Max(i,j:longint):longint;
begin
  if i>j then
    Result:=i
  else
    Result:=j;
end;

function Min(i,j:longint):longint;
begin
  if i<j then
    Result:=i
  else
    Result:=j;
end;

{------------------------------------------------------------------------------}
{ MATH FUNCTIONS                                                               }
{------------------------------------------------------------------------------}

function ExpXY(x,y:extended):extended;
begin
  result:=Exp(y*ln(x));
end;

{------------------------------------------------------------------------------}
{ STRING FORMATING FUNCTIONS                                                   }
{------------------------------------------------------------------------------}

function FormatNumber(l:LongInt): String;
begin
  Result:= FormatFloat('###,###,###,##0.00',StrToFloat(IntToStr(l)));
end;

function FormatCurrency(value:real):string;
var
  s, s2 :string;
  n: integer;
  minusflag : boolean;
begin
  minusflag:=(value<0);
  s:=format('%.2f',[abs(value)]);
  s2:=copy(s,length(s)-2,3);
  s:=copy(s,1,length(s)-3);
  n:=length(S);
  while n>3 do
  begin
    s2:=','+copy(s,n-2,3)+s2;
    n:=n-3;
  end;
  if n>0 then
  begin
    s2:=copy(s,1,n)+s2;
  end;
  if minusflag then
    result:='$-'+s2
  else
    result:='$'+s2;
end;

{------------------------------------------------------------------------------}
{  ADDS ZEROS TO FRONT OF STRING                                               }
{------------------------------------------------------------------------------}

function LeftPadZero(const Value:String; Length:byte):string;
begin
  Result:=Value;
  while ord(Result[0]) < Length do
    Result:='0'+Value;
end;


{------------------------------------------------------------------------------}
{  RETURNS N SPACES                                                            }
{------------------------------------------------------------------------------}

function spaces(n:byte):string;
begin
  Result:='';
  while n>0 do begin
    dec(n);
    Result:=Result+' ';
    end;
end;

{------------------------------------------------------------------------------}
{  TYPEINFO HOW TO REMINDER PROC                                               }
{------------------------------------------------------------------------------}

function GetEnumString(TypeInfo:PTypeInfo;Ordinal:longint):String;
begin
  Result:=GetEnumName(TypeInfo,Ordinal)^;
end;

{------------------------------------------------------------------------------}
{  PCHAR AND PSTRING UTILITIES                                                 }
{------------------------------------------------------------------------------}

function MakePChar(const Value:String):PChar;
begin
  GetMem(Result,256);           {make room for a pascal maxlen pchar}
  StrPCopy(Result,Value);       {copy string passed into buffer}
end;

procedure FreePChar(Value:PChar);
begin
  FreeMem(Value,256);
end;

function ReceivePChar(Value:PChar):String;
begin
  Result:=StrPas(Value);
  FreePChar(Value);
end;

procedure MovePChar2PString(Dest:PString;Source:PChar;aFree:Boolean);
begin
  AssignStr(Dest,StrPas(Source));
  if aFree then
    FreePChar(Source);
end;


end.